home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cocktail / puma.lha / puma / src / sem.puma < prev    next >
Text File  |  1992-09-25  |  39KB  |  1,396 lines
  1. /* Ich, Doktor Josef Grosch, Informatiker, 19.4.1991 */
  2.  
  3. TRAFO Semantics PUBLIC Semantics RemoveTreeTypes
  4.  
  5. EXPORT {
  6. FROM Idents    IMPORT tIdent;
  7. FROM Sets    IMPORT tSet;
  8. FROM Tree    IMPORT tTree;
  9.  
  10. VAR TypeCount    : SHORTCARD;
  11. VAR TypeNames, UserTypes    : tSet;
  12.  
  13. PROCEDURE IdentifyVar    (node: tTree; i: tIdent): tTree;
  14. PROCEDURE LookupClass    (Classes: tTree; i: CARDINAL): tTree;
  15. }
  16.  
  17. GLOBAL {
  18.  
  19. FROM SYSTEM    IMPORT TSIZE, ADR;
  20. FROM General    IMPORT Max;
  21. FROM IO        IMPORT StdOutput, WriteN, WriteS, WriteI, WriteNl;
  22. FROM DynArray    IMPORT MakeArray, ReleaseArray;
  23. FROM Strings    IMPORT tString, IntToString, Append, Concatenate, ArrayToString;
  24. FROM Idents    IMPORT WriteIdent, tIdent, NoIdent, MakeIdent, MaxIdent, GetString;
  25. FROM Texts    IMPORT MakeText;
  26. FROM Scanner    IMPORT Error, ErrorI, Warning, WarningI;
  27. FROM Positions    IMPORT tPosition, NoPosition;
  28.  
  29. FROM Sets    IMPORT
  30.    tSet        , MakeSet    , ReleaseSet    , AssignEmpty    ,
  31.    IsElement    , Include    , IsEmpty    , Extract    ,
  32.    Select    , Difference    , Complement    , ForallDo    ,
  33.    IsSubset    , Minimum    , Maximum    , Assign    ,
  34.    Exclude    , Intersection    , WriteSet    ;
  35.  
  36. FROM Tree    IMPORT
  37.    tTree    , NoTree    , TreeRoot    , mCall        ,
  38.    mCompose    , mDecompose    , mDontCare    , mDontCare1    ,
  39.    mNilTest    , mNoPattern    , mOnePattern    , mVarDef    ,
  40.    mNoFormal    , mFormal    , mNodeTypes    , mUserType    ,
  41.    mVar        , mConsType    , mField    , mNoClass    ,
  42.    mOneExpr    , mNoExpr    , mValue    , mDummyFormal    ,
  43.    mWriteStr    , f        , ForallClasses    , ForallAttributes,
  44.    Options    , ReverseTree    , IsType    , Class        ,
  45.    Test        , Dummy        ;
  46.  
  47. VAR
  48.    ExternNames    ,
  49.    LocExternNames,
  50.    ActTypes    ,
  51.    ActNames    ,
  52.    UserNames    ,
  53.    LabelNames    ,
  54.    ParamNames    ,
  55.    RoutineNames    : tSet;
  56.    dFormals    ,
  57.    Parameters    ,
  58.    Decls    ,
  59.    Args        ,
  60.    InFormals    ,
  61.    OutFormals    ,
  62.    ReturnFormal    ,
  63.    Node        ,
  64.    Var        ,
  65.    TreeName    ,
  66.    ActTree    ,
  67.    ActClass    : tTree;
  68.    RuleCount    ,
  69.    VarCount    : INTEGER;
  70.    ProcName    ,
  71.    ParamName    : tIdent;
  72.    HasLocals    ,
  73.    IsFunction    ,
  74.    IsOutput    ,
  75.    Mode        ,
  76.    Success    : BOOLEAN;
  77.    String    ,
  78.    String1    : tString;
  79.    i        : CARDINAL;
  80.    nNoFormal    : tTree;
  81.  
  82. PROCEDURE IdentifyClass (t: tTree; Ident: tIdent): tTree;
  83.    VAR class    : tTree;
  84.    BEGIN
  85.       WHILE t^.Kind = Class DO
  86.      WITH t^.Class DO
  87.         IF Name = Ident THEN RETURN t; END;
  88.         class := IdentifyClass (Extensions, Ident);
  89.         IF class # NoTree THEN RETURN class; END;
  90.         t := Next;    (* RETURN IdentifyClass (Next, Ident); *)
  91.      END;
  92.       END;
  93.       RETURN NoTree;
  94.    END IdentifyClass;
  95.  
  96. PROCEDURE IdentifyTree (i: tIdent): tTree;    (* is i name of a tree type ? *)
  97.    VAR Node: tTree;
  98.    BEGIN
  99.       Node := TreeRoot^.Spec.TreeNames;
  100.       WHILE Node^.Kind = Tree.TreeName DO
  101.      IF Node^.TreeName.Name = i THEN RETURN Node; END;
  102.      Node := Node^.TreeName.Next;
  103.       END;
  104.       RETURN NoTree;
  105.    END IdentifyTree;
  106.  
  107. PROCEDURE IdentifyProc (i: tIdent): tTree;    (* is i name of a subroutine ? *)
  108.    VAR Node: tTree;
  109.    BEGIN
  110.       Node := TreeRoot^.Spec.Routines;
  111.       WHILE Node^.Kind # Tree.NoRoutine DO
  112.      IF Node^.Routine.Name = i THEN RETURN Node; END;
  113.      Node := Node^.Routine.Next;
  114.       END;
  115.       RETURN NoTree;
  116.    END IdentifyProc;
  117.  
  118. PROCEDURE IdentifyVar (Node: tTree; i: tIdent): tTree;    (* is i name of a variable ? *)
  119.    BEGIN
  120.       WHILE Node^.Kind # Tree.NoFormal DO
  121.      IF Node^.Formal.Name = i THEN RETURN Node; END;
  122.      Node := Node^.Formal.Next;
  123.       END;
  124.       RETURN NoTree;
  125.    END IdentifyVar;
  126.  
  127. PROCEDURE IdentifyClass2 (i: tIdent; VAR TreeName: tTree): tTree; (* is i a node type ? *)
  128.    VAR Class: tTree;
  129.    BEGIN
  130.       TreeName := TreeRoot^.Spec.TreeNames;
  131.       WHILE TreeName^.Kind = Tree.TreeName DO
  132.      Class := IdentifyClass (TreeName^.TreeName.Classes, i);
  133.      IF Class # NoTree THEN RETURN Class; END;
  134.      TreeName := TreeName^.TreeName.Next;
  135.       END;
  136.       TreeName := NoTree;
  137.       RETURN NoTree;
  138.    END IdentifyClass2;
  139.  
  140. PROCEDURE LookupClass (Classes: tTree; i: CARDINAL): tTree;
  141.    VAR Class: tTree;
  142.    BEGIN
  143.       IF Classes^.Kind = Tree.NoClass THEN RETURN NoTree; END;
  144.       WITH Classes^.Class DO
  145.      IF Index = i THEN RETURN Classes; END;
  146.      Class := LookupClass (Extensions, i);
  147.      IF Class # NoTree THEN RETURN Class; END;
  148.      RETURN LookupClass (Next, i);
  149.       END;
  150.    END LookupClass;
  151.  
  152. PROCEDURE MakeTypes (Index: INTEGER; Classes: tTree; VAR Types: tSet);
  153.    BEGIN
  154.       ActTypes := Types;
  155.       ForallClasses (Classes, ProcFormals);
  156.       Include (ActTypes, Index);
  157.       Types := ActTypes;
  158.    END MakeTypes;
  159.  
  160. PROCEDURE CheckSubtype (t1, t2: tTree; Pos: tPosition);
  161.    BEGIN
  162.       IF t1^.Kind = Tree.NodeTypes THEN
  163.      IF t2^.Kind = Tree.UserType THEN
  164.         Warning ("tree-type required", Pos);
  165.      ELSIF t2^.NodeTypes.TreeName # t1^.NodeTypes.TreeName THEN
  166.         Error ("incompatible tree types", Pos);
  167.      ELSIF NOT IsSubset (t2^.NodeTypes.Types, t1^.NodeTypes.Types) THEN
  168.         Error ("subtype required", Pos);
  169.      END;
  170.       ELSIF t1^.Kind = Tree.UserType THEN
  171.      IF t2^.Kind = Tree.NodeTypes THEN
  172.         Warning ("user-type required", Pos);
  173.      ELSIF t2^.UserType.Type # t1^.UserType.Type THEN
  174.         Warning ("incompatible types", Pos);
  175.      END;
  176.       END;
  177.    END CheckSubtype;
  178.  
  179. PROCEDURE CheckType (t1, t2: tTree; Pos: tPosition);
  180.    VAR t    : tSet;
  181.    BEGIN
  182.       IF t1^.Kind = Tree.NodeTypes THEN
  183.      IF t2^.Kind = Tree.UserType THEN
  184.         Warning ("tree-type required", Pos);
  185.      ELSIF t2^.NodeTypes.TreeName # t1^.NodeTypes.TreeName THEN
  186.         Error ("incompatible tree types", Pos);
  187.      ELSE
  188.         MakeSet (t, t1^.NodeTypes.TreeName^.TreeName.ClassCount);
  189.         Assign (t, t1^.NodeTypes.Types);
  190.         Intersection (t, t2^.NodeTypes.Types);
  191.         IF IsEmpty (t) THEN
  192.            Warning ("incompatible node types", Pos);
  193.         END;
  194.         ReleaseSet (t);
  195.      END;
  196.       ELSIF t1^.Kind = Tree.UserType THEN
  197.      IF t2^.Kind = Tree.NodeTypes THEN
  198.         Warning ("user-type required", Pos);
  199.      ELSIF t2^.UserType.Type # t1^.UserType.Type THEN
  200.         Warning ("incompatible types", Pos);
  201.      END;
  202.       END;
  203.    END CheckType;
  204.  
  205. PROCEDURE TransformPattern (t: tTree): tTree;
  206.    VAR TreeName, s, object    : tTree;
  207.    BEGIN
  208.       CASE t^.Kind OF
  209.       | Tree.NoExpr    : RETURN mNoPattern (t^.NoExpr.Pos);
  210.  
  211.       | Tree.OneExpr    : WITH t^.OneExpr DO
  212.         RETURN mOnePattern (TransformPattern (Expr), TransformPattern (Next));
  213.      END;
  214.  
  215.       | Tree.NamedExpr    : WITH t^.NamedExpr DO
  216.         Error ("pattern name illegal", Expr^.Expr.Pos);
  217.         RETURN mOnePattern (TransformPattern (Expr), TransformPattern (Next));
  218.      END;
  219.  
  220.       | Tree.Compose    : WITH t^.Compose DO
  221.         IF Expr^.Kind = Tree.VarUse THEN
  222.            Object := IdentifyClass2 (Expr^.VarUse.Name, TreeName);
  223.            IF Object = NoTree THEN Object := IdentifyProc (Expr^.VarUse.Name); END;
  224.         ELSIF (Expr^.Kind = Tree.Binary) AND
  225.           (Expr^.Binary.Lop^.Kind = Tree.VarUse) AND
  226.           (Expr^.Binary.Rop^.Kind = Tree.VarUse) THEN
  227.            Object := IdentifyTree (Expr^.Binary.Lop^.VarUse.Name);
  228.            IF Object # NoTree THEN
  229.           Object := IdentifyClass (Object^.TreeName.Classes, Expr^.Binary.Rop^.VarUse.Name);
  230.            END;
  231.         ELSE
  232.            Object := NoTree;
  233.         END;
  234.  
  235.         Expr := TransformExpr (Expr);
  236.         IF Object # NoTree THEN
  237.            IF Object^.Kind = Class THEN
  238.           Exprs := TransformName (Exprs, Object^.Class.Formals);
  239.           s := mDecompose (Pos, Selector, Expr, TransformPattern (Exprs), Widen);
  240.           s^.Decompose.Object := Object;
  241.           RETURN s;
  242.            ELSE
  243.           s := mCall (Pos, Expr, TransformExpr (Exprs), mNoPattern (Pos));
  244.           s^.Call.Object := Object;
  245.           RETURN mValue (Pos, s);
  246.            END;
  247.         ELSE
  248.            s := mCall (Pos, Expr, TransformExpr (Exprs), mNoExpr (Pos));
  249.            s^.Call.Object := Object;
  250.            RETURN mValue (Pos, s);
  251.         END;
  252.      END;
  253.  
  254.       | Tree.VarUse    : WITH t^.VarUse DO
  255.         Object := IdentifyClass2 (Name, TreeName);
  256.         IF (Object # NoTree) AND IsElement (ORD ('p'), Options) THEN
  257.            s := mDecompose (Pos, NoIdent, t, mOnePattern (mDontCare (Pos), mNoPattern (Pos)), FALSE);
  258.            s^.Decompose.Object := Object;
  259.            RETURN s;
  260.         ELSE
  261.            RETURN mVarDef (Pos, Name);
  262.         END;
  263.      END;
  264.  
  265.       | Tree.Nil    : RETURN mNilTest (t^.Nil.Pos, t^.Nil.Selector);
  266.  
  267.       | Tree.DontCare1
  268.       , Tree.DontCare    : RETURN t;
  269.       
  270.       | Tree.Binary    : WITH t^.Binary DO
  271.         IF IsElement (ORD ('p'), Options) AND (Operator = MakeIdent (String1)) AND
  272.            (Lop^.Kind = Tree.VarUse) AND (Rop^.Kind = Tree.VarUse) THEN
  273.            object := IdentifyTree (Lop^.VarUse.Name);
  274.            IF object # NoTree THEN
  275.           object := IdentifyClass (object^.TreeName.Classes, Rop^.VarUse.Name);
  276.           IF object # NoTree THEN
  277.              s := mDecompose (Pos, NoIdent, t, mOnePattern (mDontCare (Pos), mNoPattern (Pos)), FALSE);
  278.              s^.Decompose.Object := object;
  279.              RETURN s;
  280.           END;
  281.            END;
  282.         END;
  283.         RETURN mValue (Pos, TransformExpr (t));
  284.      END;
  285.  
  286.       | Tree.Call
  287.       , Tree.PreOperator
  288.       , Tree.PostOperator
  289.       , Tree.Index
  290.       , Tree.Parents
  291.       , Tree.TargetExpr
  292.       , Tree.StringExpr
  293.       , Tree.AttrDesc    : RETURN mValue (t^.Expr.Pos, TransformExpr (t));
  294.  
  295.       END;
  296.    END TransformPattern;
  297.  
  298. PROCEDURE TransformExpr (t: tTree): tTree;
  299.    VAR TreeName, s, object    : tTree;
  300.    BEGIN
  301.       CASE t^.Kind OF
  302.       | Tree.NoExpr    :
  303.  
  304.       | Tree.OneExpr    : WITH t^.OneExpr DO
  305.         Expr    := TransformExpr (Expr);
  306.         Next    := TransformExpr (Next);
  307.      END;
  308.  
  309.       | Tree.NamedExpr    : WITH t^.NamedExpr DO
  310.         Error ("argument name illegal", t^.NamedExpr.Expr^.Expr.Pos);
  311.         RETURN mOneExpr (TransformExpr (Expr), TransformExpr (Next));
  312.      END;
  313.  
  314.       | Tree.Compose    : WITH t^.Compose DO
  315.         IF Expr^.Kind = Tree.VarUse THEN
  316.            Object := IdentifyClass2 (Expr^.VarUse.Name, TreeName);
  317.            IF Object = NoTree THEN Object := IdentifyProc (Expr^.VarUse.Name); END;
  318.         ELSIF (Expr^.Kind = Tree.Binary) AND
  319.           (Expr^.Binary.Lop^.Kind = Tree.VarUse) AND
  320.           (Expr^.Binary.Rop^.Kind = Tree.VarUse) THEN
  321.            Object := IdentifyTree (Expr^.Binary.Lop^.VarUse.Name);
  322.            IF Object # NoTree THEN
  323.           Object := IdentifyClass (Object^.TreeName.Classes, Expr^.Binary.Rop^.VarUse.Name);
  324.            END;
  325.         ELSE
  326.            Object := NoTree;
  327.         END;
  328.  
  329.         Expr := TransformExpr (Expr);
  330.         IF Object # NoTree THEN
  331.            IF Object^.Kind = Class THEN
  332.           Exprs := TransformName (Exprs, Object^.Class.Formals);
  333.           Exprs := TransformExpr (Exprs);
  334.           RETURN t;
  335.            ELSE
  336.           s := mCall (Pos, Expr, TransformExpr (Exprs), mNoPattern (Pos));
  337.           s^.Call.Object := Object;
  338.           RETURN s;
  339.            END;
  340.         ELSE
  341.            s := mCall (Pos, Expr, TransformExpr (Exprs), mNoExpr (Pos));
  342.            s^.Call.Object := Object;
  343.            RETURN s;
  344.         END;
  345.      END;
  346.  
  347.       | Tree.VarUse    : WITH t^.VarUse DO
  348.         Object := IdentifyClass2 (Name, TreeName);
  349.         IF (Object # NoTree) AND IsElement (ORD ('p'), Options) THEN
  350.            s := mCompose (Pos, NoIdent, t, mOneExpr (mDontCare (Pos), mNoExpr (Pos)), FALSE);
  351.            s^.Compose.Object := Object;
  352.            RETURN s;
  353.         ELSE
  354.            Object := NoTree;
  355.            RETURN t;
  356.         END;
  357.      END;
  358.  
  359.       | Tree.Nil    :
  360.       | Tree.DontCare1    :
  361.       | Tree.DontCare    :
  362.  
  363.       | Tree.Call    : WITH t^.Call DO
  364.         IF Expr^.Kind = Tree.VarUse THEN
  365.            Object := IdentifyProc (Expr^.VarUse.Name);
  366.         ELSE
  367.            Object := NoTree;
  368.         END;
  369.         Expr  := TransformExpr (Expr);
  370.         Exprs := TransformExpr (Exprs);
  371.         IF Object # NoTree THEN
  372.            Patterns    := TransformPattern (Patterns);
  373.         ELSE
  374.            Patterns    := TransformExpr (Patterns);
  375.         END;
  376.      END;
  377.  
  378.       | Tree.Binary    : WITH t^.Binary DO
  379.         IF IsElement (ORD ('p'), Options) AND
  380.            (Lop^.Kind = Tree.VarUse) AND (Rop^.Kind = Tree.VarUse) THEN
  381.            object := IdentifyTree (Lop^.VarUse.Name);
  382.            IF object # NoTree THEN
  383.           object := IdentifyClass (object^.TreeName.Classes, Rop^.VarUse.Name);
  384.           IF object # NoTree THEN
  385.              s := mCompose (Pos, NoIdent, t, mOneExpr (mDontCare (Pos), mNoExpr (Pos)), FALSE);
  386.              s^.Compose.Object := object;
  387.              RETURN s;
  388.           END;
  389.            END;
  390.         END;
  391.         Lop        := TransformExpr (Lop);
  392.         Rop        := TransformExpr (Rop);
  393.      END;
  394.  
  395.       | Tree.PreOperator, Tree.PostOperator    : WITH t^.PreOperator DO
  396.         Expr    := TransformExpr (Expr);
  397.      END;
  398.  
  399.       | Tree.Index    : WITH t^.Index DO
  400.         Expr    := TransformExpr (Expr);
  401.         Exprs    := TransformExpr (Exprs);
  402.      END;
  403.  
  404.       | Tree.Parents    : WITH t^.Parents DO
  405.         Expr    := TransformExpr (Expr);
  406.      END;
  407.  
  408.       | Tree.TargetExpr    :
  409.       | Tree.StringExpr    :
  410.       | Tree.AttrDesc    :
  411.       END;
  412.       RETURN t;
  413.    END TransformExpr;
  414.  
  415. PROCEDURE TransformStmt (t: tTree): tTree;
  416.    BEGIN
  417.       CASE t^.Kind OF
  418.       | Tree.NoStatement: RETURN t;
  419.  
  420.       | Tree.ProcCall    : WITH t^.ProcCall DO
  421.         Call := TransformExpr (Call);
  422.         IF Call^.Kind = Tree.Call THEN
  423.            WITH Call^.Call DO
  424.           IF (Object # NoTree) AND
  425.              ((Object^.Kind = Tree.Predicate) OR (Object^.Kind = Tree.Function)) THEN
  426.              t^.Kind := Tree.Condition;
  427.           END;
  428.            END;
  429.         ELSIF Call^.Kind = Tree.StringExpr THEN
  430.            t := mWriteStr (Pos, Next, Call^.StringExpr.String);
  431.         ELSE
  432.            t^.Kind := Tree.Condition;
  433.         END;
  434.      END;
  435.  
  436.       | Tree.Assignment    : WITH t^.Assignment DO
  437.         Adr  := TransformExpr (Adr );
  438.         Expr := TransformExpr (Expr);
  439.      END;
  440.  
  441.       | Tree.Reject    :
  442.       | Tree.Fail    :
  443.       | Tree.TargetStmt    :
  444.       | Tree.Nl        :
  445.       | Tree.WriteStr    :
  446.       END;
  447.       t^.Statement.Next := TransformStmt (t^.Statement.Next);
  448.       RETURN t;
  449.    END TransformStmt;
  450.  
  451. PROCEDURE TransformName (t, Formals: tTree): tTree;
  452.    VAR
  453.       Exprs        : tTree;
  454.       Last        : POINTER TO tTree;
  455.       n, i        ,
  456.       Minimum, Maximum    : INTEGER;
  457.       PatternsSize    : LONGINT;
  458.       PatternsPtr    : POINTER TO ARRAY [0..50000] OF tTree;
  459.  
  460.    PROCEDURE Lookup (Ident: tIdent; Formals: tTree): INTEGER;
  461.       VAR i    : INTEGER;
  462.       BEGIN
  463.      i := 0;
  464.      WHILE Formals^.Kind = Tree.Formal DO
  465.         INC (i);
  466.         IF Formals^.Formal.Name = Ident THEN RETURN i; END;
  467.         Formals := Formals^.Formal.Next;
  468.      END;
  469.      RETURN 0;
  470.       END Lookup;
  471.  
  472.    BEGIN
  473.       Exprs := t;
  474.       WHILE Exprs^.Kind = Tree.OneExpr DO Exprs := Exprs^.OneExpr.Next; END;
  475.       IF Exprs^.Kind = Tree.NoExpr THEN RETURN t; END;
  476.       n := 0;
  477.       Exprs := Formals;
  478.       WHILE Exprs^.Kind = Tree.Formal DO INC (n); Exprs := Exprs^.Formal.Next; END;
  479.       PatternsSize := n + 1;
  480.       MakeArray (PatternsPtr, PatternsSize, TSIZE (tTree));
  481.       FOR i := 1 TO n DO PatternsPtr^[i] := NoTree; END;
  482.       Last := ADR (t);
  483.       Exprs := t;
  484.       i := 0;
  485.       WHILE Exprs^.Kind = Tree.OneExpr DO
  486.      INC (i);
  487.      PatternsPtr^[i] := Exprs^.OneExpr.Expr;
  488.      Last := ADR (Exprs^.OneExpr.Next);
  489.      Exprs := Exprs^.OneExpr.Next;
  490.       END;
  491.       Minimum := i + 1;
  492.       Maximum := i;
  493.       WHILE Exprs^.Kind = Tree.NamedExpr DO
  494.      i := Lookup (Exprs^.NamedExpr.Name, Formals);
  495.      IF i = 0 THEN
  496.         Error ("identifier not declared", Exprs^.NamedExpr.Expr^.Expr.Pos);
  497.      ELSIF PatternsPtr^[i] # NoTree THEN
  498.         Error ("pattern or argument multiply supplied", Exprs^.NamedExpr.Expr^.Expr.Pos);
  499.      ELSE
  500.         PatternsPtr^[i] := Exprs^.NamedExpr.Expr;
  501.      END;
  502.      Maximum := Max (Maximum, i);
  503.      Exprs := Exprs^.NamedExpr.Next;
  504.       END;
  505.       Exprs := mOneExpr (mDontCare (NoPosition), mNoExpr (NoPosition));
  506.       FOR i := Maximum TO Minimum BY -1 DO
  507.      IF PatternsPtr^[i] = NoTree THEN
  508.         Exprs := mOneExpr (mDontCare1 (NoPosition), Exprs);
  509.      ELSE
  510.         Exprs := mOneExpr (PatternsPtr^[i], Exprs);
  511.      END;
  512.       END;
  513.       Last^ := Exprs;
  514.       ReleaseArray (PatternsPtr, PatternsSize, TSIZE (tTree));
  515.       RETURN t;
  516.    END TransformName;
  517.  
  518. PROCEDURE CheckExprList (t, Formals: tTree);
  519.    BEGIN
  520.       IF (t^.Kind = Tree.NoExpr) AND (Formals^.Kind # Tree.Formal) THEN RETURN; END;
  521.       IF t^.Kind = Tree.NoExpr THEN
  522.      Error ("too few expressions or arguments", t^.NoExpr.Pos); RETURN;
  523.       END;
  524.       WITH t^.OneExpr DO
  525.      IF Expr^.Kind = Tree.DontCare THEN RETURN; END;
  526.      IF Formals^.Kind = Tree.NoFormal THEN
  527.         Error ("too many expressions or arguments", Expr^.Expr.Pos); RETURN;
  528.      END;
  529.      CheckExpr (Expr, Formals);
  530.      CheckExprList (Next, Formals^.Formal.Next);
  531.       END;
  532.    END CheckExprList;
  533.  
  534. PROCEDURE CheckInParams (t, Formals: tTree);
  535.    BEGIN
  536.       IF (t^.Kind = Tree.NoExpr) OR (Formals^.Kind # Tree.Formal) THEN RETURN; END;
  537.       WITH t^.OneExpr DO
  538.      IF Expr^.Kind = Tree.DontCare THEN RETURN; END;
  539.      IF Formals^.Formal.Path^.Var.IsOutput AND (Expr^.Kind = Tree.VarUse) AND
  540.         (Expr^.VarUse.Object # NoTree) AND (Expr^.VarUse.Object^.Formal.Path^.Kind = Tree.Var) AND
  541.         NOT Expr^.VarUse.Object^.Formal.Path^.Var.IsOutput THEN
  542.         Expr^.VarUse.Object^.Formal.Path^.Var.IsRegister := FALSE;
  543.      END;
  544.      CheckInParams (Next, Formals^.Formal.Next);
  545.       END;
  546.    END CheckInParams;
  547.  
  548. PROCEDURE CheckCallExprs (t, Formals: tTree);
  549.    BEGIN
  550.       IF (t^.Kind = Tree.NoExpr) AND (Formals^.Kind # Tree.Formal) THEN RETURN; END;
  551.       IF t^.Kind = Tree.NoExpr THEN
  552.      Error ("too few expressions or arguments", t^.NoExpr.Pos); RETURN;
  553.       END;
  554.       WITH t^.OneExpr DO
  555.      IF Expr^.Kind = Tree.DontCare THEN
  556.         Expr^.DontCare.Tempos := MakeTempos (Formals);
  557.         RETURN;
  558.      END;
  559.      IF Formals^.Kind = Tree.NoFormal THEN
  560.         Error ("too many expressions or arguments", Expr^.Expr.Pos); RETURN;
  561.      END;
  562.      CheckExprVar (Expr, Formals);
  563.      CheckCallExprs (Next, Formals^.Formal.Next);
  564.       END;
  565.    END CheckCallExprs;
  566.  
  567. PROCEDURE CheckExprVar (t, Formals: tTree);
  568.    BEGIN
  569.       IF t^.Kind = Tree.Compose THEN
  570.      t^.Compose.Tempo := MakeVar ();
  571.      IF Formals^.Kind = Tree.Formal THEN
  572.         t^.Compose.TypeDesc := Formals^.Formal.TypeDesc;
  573.      ELSE
  574.         t^.Compose.TypeDesc := t^.Compose.Object^.Class.TypeDesc;
  575.      END;
  576.       ELSIF t^.Kind = Tree.DontCare1 THEN
  577.      t^.DontCare1.Tempo := MakeVar ();
  578.      IF Formals^.Kind = Tree.Formal THEN
  579.         t^.DontCare1.TypeDesc := Formals^.Formal.TypeDesc;
  580.      END;
  581.       END;
  582.       CheckExpr (t, Formals);
  583.    END CheckExprVar;
  584.  
  585. PROCEDURE CheckExpr (t, Formals: tTree);
  586.    BEGIN
  587.       CASE t^.Kind OF
  588.  
  589.       | Tree.Compose: WITH t^.Compose DO
  590.         IF Selector # NoIdent THEN
  591.            Warning ("label ignored", Pos);
  592.         END;
  593.         IF Formals^.Kind = Tree.Formal THEN
  594.            CheckSubtype (Formals^.Formal.TypeDesc, Object^.Class.TypeDesc, Pos);
  595.         END;
  596.         IF Object = NoTree THEN
  597.            CheckExpr (Expr, dFormals);
  598.         ELSE
  599.            CheckExpr2 (Expr);
  600.         END;
  601.         CheckExprList (Exprs, Object^.Class.Formals);
  602.      END;
  603.  
  604.       | Tree.VarUse: WITH t^.VarUse DO
  605.         IF IsElement (Name, LabelNames) THEN
  606.            Object := IdentifyVar (Decls, Name);
  607.            IF (Object # NoTree) AND (Formals^.Kind = Tree.Formal) THEN
  608.           CheckSubtype (Formals^.Formal.TypeDesc, Object^.Formal.TypeDesc, Pos);
  609.            END;
  610.         ELSIF NOT IsElement (Name, ExternNames) AND
  611.           NOT IsElement (Name, LocExternNames) AND
  612.           NOT IsElement (Name, UserNames) THEN
  613.            IF IsElement (ORD ('e'), Options) THEN
  614.           ErrorI ("label not declared or computed", Pos, Name);
  615.            ELSIF IsElement (ORD ('v'), Options) AND NOT IsElement (ORD ('s'), Options) THEN
  616.           WarningI ("label not declared or computed", Pos, Name);
  617.            END;
  618.            Include (UserNames, Name);
  619.         END;
  620.      END;
  621.  
  622.       | Tree.Nil: WITH t^.Nil DO
  623.         IF Selector # NoIdent THEN
  624.            Warning ("label ignored", Pos);
  625.         END;
  626.      END;
  627.  
  628.       | Tree.Call: WITH t^.Call DO
  629.         IF Object = NoTree THEN
  630.            CheckExpr (Expr, dFormals);
  631.            IF Expr^.Kind = Tree.VarUse THEN
  632.           ProcName := Expr^.VarUse.Name;
  633.            ELSIF (Expr^.Kind = Tree.Binary) AND
  634.              (Expr^.Binary.Lop^.Kind = Tree.VarUse) THEN
  635.           ProcName := Expr^.Binary.Lop^.VarUse.Name;
  636.            ELSE
  637.           ProcName := NoIdent;
  638.            END;
  639.  
  640.            IF NOT IsElement (ProcName, ExternNames) AND
  641.           NOT IsElement (ProcName, LocExternNames) AND
  642.           NOT IsElement (ProcName, UserNames) THEN
  643.           IF IsElement (ORD ('e'), Options) THEN
  644.              ErrorI ("subroutine identifier not declared", Pos, ProcName);
  645.           ELSIF IsElement (ORD ('v'), Options) AND NOT IsElement (ORD ('s'), Options) THEN
  646.              WarningI ("subroutine identifier not declared", Pos, ProcName);
  647.           END;
  648.           Include (UserNames, ProcName);
  649.            END;
  650.            CheckCallExprs (Exprs, dFormals);
  651.            CheckCallExprs (Patterns, dFormals);
  652.         ELSIF IsType (Object, Tree.Routine) THEN
  653.            CheckExpr2 (Expr);
  654.            IF (Object^.Kind = Tree.Function) AND (Formals^.Kind = Tree.Formal) THEN
  655.           CheckSubtype (Formals^.Formal.TypeDesc, Object^.Function.ReturnForm^.Formal.TypeDesc, Pos);
  656.            END;
  657.            CheckCallExprs (Exprs, Object^.Routine.InForm);
  658.            CheckCallPatterns (Patterns, Object^.Routine.OutForm);
  659.            CheckInParams (Exprs, Object^.Routine.InForm);
  660.         ELSE
  661.            Error ("subroutine identifier required", Pos);
  662.         END;
  663.      END;
  664.  
  665.       | Tree.Binary: WITH t^.Binary DO
  666.         CheckExprVar (Lop, dFormals);
  667.         CheckExprVar (Rop, dFormals);
  668.      END;
  669.  
  670.       | Tree.PreOperator, Tree.PostOperator: WITH t^.PreOperator DO
  671.         CheckExprVar (Expr, Formals);
  672.      END;
  673.  
  674.       | Tree.Index: WITH t^.Index DO
  675.         CheckExprVar (Expr, dFormals);
  676.         CheckExprList (Exprs, dFormals);
  677.      END;
  678.  
  679.       | Tree.Parents: WITH t^.Parents DO
  680.         CheckExprVar (Expr, Formals);
  681.      END;
  682.  
  683.       | Tree.AttrDesc: WITH t^.AttrDesc DO
  684.         IF IsElement (Name, LabelNames) THEN
  685.            Object := IdentifyVar (Decls, Name);
  686.            IF Object^.Formal.TypeDesc^.Kind = Tree.NodeTypes THEN
  687.           ActClass := LookupClass (Object^.Formal.TypeDesc^.NodeTypes.TreeName^.TreeName.Classes,
  688.                   Minimum (Object^.Formal.TypeDesc^.NodeTypes.Types));
  689.           Type := ActClass^.Class.Name;
  690.            ELSE
  691.           Error ("tree-type required", Pos);
  692.            END;
  693.         ELSE
  694.            Error ("label not declared or computed", Pos);
  695.         END;
  696.      END;
  697.  
  698.       ELSE
  699.       END;
  700.    END CheckExpr;
  701.  
  702. PROCEDURE CheckExpr2 (t: tTree);
  703.    BEGIN
  704.       CASE t^.Kind OF
  705.  
  706.       | Tree.VarUse: WITH t^.VarUse DO
  707.         Object := IdentifyVar (Decls, Name);
  708.      END;
  709.  
  710.       | Tree.Binary: WITH t^.Binary DO
  711.         CheckExpr2 (Lop);
  712.         CheckExpr2 (Rop);
  713.      END;
  714.  
  715.       | Tree.Compose:
  716.         CheckExpr (t, dFormals);
  717.       END;
  718.    END CheckExpr2;
  719.  
  720. PROCEDURE CheckPatternList (t, Formals: tTree);
  721.    VAR Pattern    : tTree;
  722.    BEGIN
  723.       IF (t^.Kind = Tree.NoPattern) AND (Formals^.Kind # Tree.Formal) THEN RETURN; END;
  724.       IF t^.Kind = Tree.NoPattern THEN
  725.      Error ("too few patterns", t^.NoPattern.Pos); RETURN;
  726.       END;
  727.       Pattern := t^.OnePattern.Pattern;
  728.       IF Pattern^.Kind = Tree.DontCare THEN RETURN; END;
  729.       IF Formals^.Kind = Tree.NoFormal THEN
  730.      Error ("too many patterns", t^.OnePattern.Pattern^.Pattern.Pos); RETURN;
  731.       END;
  732.       CheckPattern (Pattern, Formals, Formals^.Formal.Path);
  733.       CheckPatternList (t^.OnePattern.Next, Formals^.Formal.Next);
  734.    END CheckPatternList;
  735.  
  736. PROCEDURE CheckSubPatterns (t, Formals, Path: tTree);
  737.    VAR Pattern    : tTree;
  738.    BEGIN
  739.       IF (t^.Kind = Tree.NoPattern) AND (Formals^.Kind # Tree.Formal) THEN RETURN; END;
  740.       IF t^.Kind = Tree.NoPattern THEN
  741.      Error ("too few patterns", t^.NoPattern.Pos); RETURN;
  742.       END;
  743.       Pattern := t^.OnePattern.Pattern;
  744.       IF Pattern^.Kind = Tree.DontCare THEN RETURN; END;
  745.       IF Formals^.Kind = Tree.NoFormal THEN
  746.      Error ("too many patterns", Pattern^.Pattern.Pos); RETURN;
  747.       END;
  748.       CheckPattern  (Pattern, Formals, mField (Path, Formals^.Formal.Name));
  749.       CheckSubPatterns (t^.OnePattern.Next, Formals^.Formal.Next, Path);
  750.    END CheckSubPatterns;
  751.  
  752. PROCEDURE CheckCallPatterns (t, Formals: tTree);
  753.    BEGIN
  754.       IF (t^.Kind = Tree.NoPattern) AND (Formals^.Kind # Tree.Formal) THEN RETURN; END;
  755.       IF t^.Kind = Tree.NoPattern THEN
  756.      Error ("too few patterns or arguments", t^.NoPattern.Pos); RETURN;
  757.       END;
  758.       WITH t^.OnePattern DO
  759.      IF Pattern^.Kind = Tree.DontCare THEN
  760.         Pattern^.DontCare.Tempos := MakeTempos (Formals);
  761.         RETURN;
  762.      END;
  763.      IF Formals^.Kind = Tree.NoFormal THEN
  764.         Error ("too many patterns or arguments", Pattern^.Pattern.Pos); RETURN;
  765.      END;
  766.      Pattern^.Pattern.Tempo := MakeVar ();
  767.      Pattern^.Pattern.TypeDesc := Formals^.Formal.TypeDesc;
  768.      CheckPattern (Pattern, Formals, mVar (Pattern^.Pattern.Tempo, FALSE, TRUE));
  769.      CheckCallPatterns (Next, Formals^.Formal.Next);
  770.       END;
  771.    END CheckCallPatterns;
  772.  
  773. PROCEDURE CheckPattern (t, Formals, Path: tTree);
  774.    BEGIN
  775.       t^.Pattern.Path := Path;
  776.       CASE t^.Kind OF
  777.  
  778.       | Tree.Decompose: WITH t^.Decompose DO
  779.         IF Selector # NoIdent THEN
  780.            IF IsElement (Selector, LabelNames) THEN
  781.           Error ("label multiply declared", Pos);
  782.            ELSE
  783.           Include (LabelNames, Selector);
  784.            END;
  785.            IF Widen AND (Formals^.Kind = Tree.Formal) THEN
  786.           Decls := mFormal (Decls, Selector, Formals^.Formal.TypeDesc, Path);
  787.            ELSE
  788.           Decls := mFormal (Decls, Selector, Object^.Class.TypeDesc, Path);
  789.            END;
  790.         END;
  791.  
  792.         IF Formals^.Kind = Tree.Formal THEN
  793.            CheckSubtype (Formals^.Formal.TypeDesc, Object^.Class.TypeDesc, Pos);
  794.         END;
  795.         IF Object = NoTree THEN
  796.            CheckExpr (Expr, dFormals);
  797.         ELSE
  798.            CheckExpr2 (Expr);
  799.         END;
  800.         CheckSubPatterns (Patterns, Object^.Class.Formals, mConsType (Path, Object^.Class.Name));
  801.      END;
  802.  
  803.       | Tree.VarDef: WITH t^.VarDef DO
  804.         IF IsElement (Name, LabelNames) THEN
  805.            IF NOT IsElement (ORD ('k'), Options) THEN
  806.           Error ("label multiply declared", Pos);
  807.            END;
  808.            Object := IdentifyVar (Decls, Name);
  809.            IF Formals^.Kind = Tree.Formal THEN
  810.           CheckType (Formals^.Formal.TypeDesc, Object^.Formal.TypeDesc, Pos);
  811.            END;
  812.         ELSE
  813.            Include (LabelNames, Name);
  814.            IF Formals^.Kind = Tree.Formal THEN
  815.           Decls := mFormal (Decls, Name, Formals^.Formal.TypeDesc, Path);
  816.            END;
  817.            Object := NoTree;
  818.         END;
  819.      END;
  820.  
  821.       | Tree.NilTest: WITH t^.NilTest DO
  822.         IF Selector # NoIdent THEN
  823.            IF IsElement (Selector, LabelNames) THEN
  824.           Error ("label multiply declared", Pos);
  825.            ELSE
  826.           Include (LabelNames, Selector);
  827.            END;
  828.            IF Formals^.Kind = Tree.Formal THEN
  829.           Decls := mFormal (Decls, Selector, Formals^.Formal.TypeDesc, Path);
  830.            END;
  831.         END;
  832.      END;
  833.  
  834.       | Tree.Value: CheckExprVar (t^.Value.Expr, dFormals);
  835.  
  836.       ELSE
  837.       END;
  838.    END CheckPattern;
  839.  
  840. PROCEDURE MakeVar (): tIdent;
  841.    VAR String1, String2    : tString;
  842.    BEGIN
  843.       INC (VarCount);
  844.       ArrayToString ("yyV", String1);
  845.       IntToString (VarCount, String2);
  846.       Concatenate (String1, String2);
  847.       RETURN MakeIdent (String1);
  848.    END MakeVar;
  849.  
  850. PROCEDURE MakeTempos (Formals: tTree): tTree;
  851.    BEGIN
  852.       IF Formals^.Kind = Tree.Formal THEN
  853.      WITH Formals^.Formal DO
  854.         RETURN mFormal (MakeTempos (Next), MakeVar (), TypeDesc, Path);
  855.      END;
  856.       ELSE
  857.      RETURN nNoFormal;
  858.       END;
  859.    END MakeTempos;
  860. }
  861.  
  862. BEGIN {
  863.    dFormals := mDummyFormal (NoTree); dFormals^.DummyFormal.Next := dFormals;
  864.    nNoFormal := mNoFormal ();
  865.    ArrayToString (".", String1);
  866. }
  867.  
  868. PROCEDURE Semantics (t: Tree)
  869.  
  870. Spec (..) :- {
  871.     TypeCount := MaxIdent ();
  872.     MakeSet (RoutineNames    , TypeCount);
  873.     MakeSet (LabelNames    , TypeCount);
  874.     MakeSet (ParamNames    , TypeCount);
  875.     MakeSet (TypeNames    , TypeCount);
  876.     MakeSet (ExternNames    , TypeCount);
  877.     MakeSet (LocExternNames    , TypeCount);
  878.     MakeSet (UserTypes    , TypeCount);
  879.     MakeSet (UserNames    , TypeCount);
  880.     ClassFormals (TreeNames);
  881.     Semantics (Public);
  882.     CollectExtern (Extern, ExternNames);
  883.     ProcFormals (Routines);
  884.     Semantics (Routines);
  885.       IF IsElement (ORD ('o'), Options) AND NOT IsEmpty (UserNames) THEN
  886.     WriteNl (StdOutput);
  887.     WriteS (StdOutput, "Undefined External Names"); WriteNl (StdOutput);
  888.     WriteS (StdOutput, "------------------------"); WriteNl (StdOutput);
  889.     WriteNl (StdOutput);
  890.     FOR i := 1 TO TypeCount DO
  891.        IF IsElement (i, UserNames) THEN
  892.           WriteIdent (StdOutput, i); WriteNl (StdOutput);
  893.        END;
  894.     END;
  895.       END;
  896. }; .
  897. Name (..) :- {
  898.     Object := IdentifyProc (Name);
  899.     IF Object = NoTree THEN
  900.        ErrorI ("subroutine identifier not declared", Pos, Name);
  901.     ELSE
  902.        Object^.Routine.IsExtern := TRUE;
  903.         END;
  904.     Semantics (Next);
  905. }; .
  906. Procedure (..) ;
  907. Predicate (..) :- {
  908.     AssignEmpty (LocExternNames);
  909.     CollectExtern (Extern, LocExternNames);
  910.     IF IsElement (Name, RoutineNames) THEN
  911.        Error ("routine identifier multiply declared", Pos);
  912.         ELSE
  913.        Include (RoutineNames, Name);
  914.         END;
  915.     AssignEmpty (ParamNames);
  916.     Check (InParams);
  917.     Check (OutParams);
  918.     InFormals := InForm;
  919.     OutFormals := OutForm;
  920.     Parameters := ParamDecls;
  921.     IsFunction := FALSE;
  922.     RuleCount := 0;
  923.     Check (Rules);
  924.     Semantics (Next);
  925. }; .
  926. Function (..) :- {
  927.     AssignEmpty (LocExternNames);
  928.     CollectExtern (Extern, LocExternNames);
  929.     IF IsElement (Name, RoutineNames) THEN
  930.        Error ("routine identifier multiply declared", Pos);
  931.         ELSE
  932.        Include (RoutineNames, Name);
  933.         END;
  934.     AssignEmpty (ParamNames);
  935.     Check (InParams);
  936.     Check (OutParams);
  937.     Check (ReturnParams);
  938.     InFormals := InForm;
  939.     OutFormals := OutForm;
  940.     ReturnFormal := ReturnForm;
  941.     Parameters := ParamDecls;
  942.     IsFunction := TRUE;
  943.     RuleCount := 0;
  944.     Check (Rules);
  945.     Semantics (Next);
  946. }; .
  947.  
  948.  
  949. PROCEDURE CollectExtern (t: Tree, REF Names: tSet)
  950.  
  951. Name (..), _ :-
  952.     Include (Names, Name);
  953.     CollectExtern (Next, Names);
  954.     .
  955.  
  956.  
  957. PROCEDURE ProcFormals (t: Tree)
  958.  
  959. Procedure (..) ;
  960. Predicate (..) :- {
  961.     Args := nNoFormal;
  962.     Decls := nNoFormal;
  963.     AssignEmpty (ParamNames);
  964.     IsOutput := FALSE;
  965.     ProcFormals (InParams);
  966.     InForm := ReverseTree (Args);
  967.     Args := nNoFormal;
  968.     IsOutput := TRUE;
  969.     ProcFormals (OutParams);
  970.     OutForm := ReverseTree (Args);
  971.     ParamDecls := Decls;
  972.     ProcFormals (Next);
  973. }; .
  974. Function (..) :- {
  975.     Args := nNoFormal;
  976.     Decls := nNoFormal;
  977.     AssignEmpty (ParamNames);
  978.     IsOutput := FALSE;
  979.     ProcFormals (InParams);
  980.     InForm := ReverseTree (Args);
  981.     Args := nNoFormal;
  982.     IsOutput := TRUE;
  983.     ProcFormals (OutParams);
  984.     OutForm := ReverseTree (Args);
  985.     Args := nNoFormal;
  986.     IsOutput := TRUE;
  987.     ProcFormals (ReturnParams);
  988.     ReturnForm := ReverseTree (Args);
  989.     ParamDecls := Decls;
  990.     ProcFormals (Next);
  991. }; .
  992. Param (..) :- {
  993.     IF IsElement (Name, ParamNames) THEN
  994.        Error ("parameter identifier multiply declared", Pos);
  995.         ELSE
  996.        Include (ParamNames, Name);
  997.         END;
  998.     ParamName := Name;
  999.     Mode := IsRef;
  1000.     ProcFormals (Type);
  1001.     ProcFormals (Next);
  1002. }; .
  1003. Type (..) :- {
  1004.     IF (Name # NoIdent) AND (Names^.Kind # Tree.NoName) THEN
  1005.        TreeName := IdentifyTree (Name);
  1006.        IF TreeName # NoTree THEN
  1007.           MakeSet (ActTypes, TreeName^.TreeName.ClassCount);
  1008.        ELSE
  1009.           Error ("tree type not declared", Pos);
  1010.        END;
  1011.     ELSIF (Name # NoIdent) AND (Names^.Kind = Tree.NoName) THEN
  1012.        TreeName := IdentifyTree (Name);
  1013.        IF TreeName # NoTree THEN            (* a tree type *)
  1014.           MakeSet (ActTypes, TreeName^.TreeName.ClassCount);
  1015.           MakeTypes (TreeName^.TreeName.Classes^.Class.Index, TreeName^.TreeName.Classes, ActTypes);
  1016.        ELSE                        (* not a tree type *)
  1017.           ActClass := IdentifyClass2 (Name, TreeName);
  1018.           IF ActClass # NoTree THEN            (* a node type *)
  1019.          MakeSet (ActTypes, TreeName^.TreeName.ClassCount);
  1020.              MakeTypes (ActClass^.Class.Index, ActClass^.Class.Extensions, ActTypes);
  1021.           END;
  1022.        END;
  1023.     ELSIF (Name = NoIdent) AND (Names^.Kind # Tree.NoName) THEN
  1024.        ActClass := IdentifyClass2 (Names^.Name.Name, TreeName);
  1025.        IF ActClass # NoTree THEN
  1026.           MakeSet (ActTypes, TreeName^.TreeName.ClassCount);
  1027.        ELSE
  1028.           Error ("node type not declared", Names^.Name.Pos);
  1029.        END;
  1030.     ELSE
  1031.        TreeName := NoTree;
  1032.     END;
  1033.  
  1034.     IF TreeName # NoTree THEN
  1035.        ActTree := TreeName^.TreeName.Classes;
  1036.        ProcFormals (Names);
  1037.        Node := mNodeTypes (TreeName, ActTypes);
  1038.     ELSE                        (* assume user type *)
  1039.        IF Name = NoIdent THEN
  1040.           Error ("incorrect type", Pos);
  1041.        ELSE
  1042.           Include (TypeNames, Name);
  1043.        END;
  1044.        Node := mUserType (Name);
  1045.     END;
  1046.     Var   := mVar (ParamName, IsOutput OR Mode, TRUE);
  1047.     Args  := mFormal (Args , ParamName, Node, Var);
  1048.     Decls := mFormal (Decls, ParamName, Node, Var);
  1049. }; .
  1050. Name (..) :- {
  1051.     ActClass := IdentifyClass (ActTree, Name);
  1052.     IF ActClass # NoTree THEN
  1053.        Include (ActTypes, ActClass^.Class.Index);
  1054.        ForallClasses (ActClass^.Class.Extensions, ProcFormals);
  1055.     ELSE
  1056.        Error ("node type not declared", Pos);
  1057.     END;
  1058.     ProcFormals (Next);
  1059. }; .
  1060. Class (..) :- {
  1061.     Include (ActTypes, Index);
  1062. }; .
  1063.  
  1064.  
  1065. PROCEDURE ClassFormals (t: Tree)
  1066.  
  1067. TreeName (..) :- {
  1068.     ActTree := t;
  1069.     ClassCount := 0;
  1070.     ForallClasses (Classes, CountClasses);
  1071.     ForallClasses (Classes, ClassTypes);
  1072.     ForallClasses (Classes, ClassFormals);
  1073.     ClassFormals (Next);
  1074. }; .
  1075. Class (..) :- {
  1076.     Args := nNoFormal;
  1077.     ForallAttributes (t, ClassFormals);
  1078.     Formals := ReverseTree (Args);
  1079. }; .
  1080. Child (..) :- {
  1081.     ActClass := IdentifyClass (ActTree^.TreeName.Classes, Type);
  1082.     Args := mFormal (Args, Name, ActClass^.Class.TypeDesc, NoTree);
  1083. }; .
  1084. Attribute (..) :- {
  1085.     IF ({Test, Dummy} * Properties) = {} THEN
  1086.        Args := mFormal (Args, Name, mUserType (Type), NoTree);
  1087.        Include (TypeNames, Type);
  1088.     END;
  1089. }; .
  1090.  
  1091.  
  1092. PROCEDURE CountClasses (t: Tree)
  1093.  
  1094. Class (..) :- {
  1095.     INC (ActTree^.TreeName.ClassCount);
  1096.     Index := ActTree^.TreeName.ClassCount;
  1097. }; .
  1098.  
  1099.  
  1100. PROCEDURE ClassTypes (t: Tree)
  1101.  
  1102. Class (..) :- {
  1103.     TypeDesc := mNodeTypes (ActTree, ActTypes);    (* 2nd arg is dummy *)
  1104.     MakeSet (TypeDesc^.NodeTypes.Types, ActTree^.TreeName.ClassCount);
  1105.     MakeTypes (Index, Extensions, TypeDesc^.NodeTypes.Types);
  1106. }; .
  1107.  
  1108.  
  1109. PROCEDURE Check (t: Tree)
  1110.  
  1111. Reject    (_, Statement (Pos, _)) ;
  1112. Fail    (_, Statement (Pos, _)) :-
  1113.     Warning ("statement not reachable", Pos);
  1114.     REJECT
  1115.     .
  1116. Param (..) :- {
  1117.     Include (ParamNames, Name);
  1118.     Check (Next);
  1119. }; .
  1120. Rule (..) :- {
  1121.     INC (RuleCount);
  1122.     Index        := RuleCount;
  1123.     Patterns    := TransformName (Patterns, InFormals);
  1124.     Patterns    := TransformPattern (Patterns);
  1125.     Exprs        := TransformName (Exprs, OutFormals);
  1126.     Exprs        := TransformExpr (Exprs);
  1127.     Expr        := TransformExpr (Expr);
  1128.     Statements    := TransformStmt (Statements);
  1129.     VarCount    := 0;
  1130.     HasLocals    := FALSE;
  1131.     Decls        := Parameters;
  1132.     Assign (LabelNames, ParamNames);
  1133.     CheckPatternList (Patterns, InFormals);
  1134.     Check (Patterns);
  1135.     Check (Statements);
  1136.     CheckExprList (Exprs, OutFormals);
  1137.     Check (Exprs);
  1138.     IF IsFunction THEN
  1139.        IF Expr^.Kind = Tree.NoExpr THEN
  1140.           IF NOT HasReject (Statements) THEN
  1141.          Error ("function requires RETURN expression", Expr^.Expr.Pos);
  1142.           END;
  1143.        ELSE
  1144.           CheckExprVar (Expr, ReturnFormal);
  1145.           Success := FALSE;
  1146.           Check (Expr);
  1147.           HasPatterns := Success;
  1148.           IF HasPatterns AND (Expr^.Kind # Tree.Compose) AND (t^.Kind # Tree.DontCare1) THEN
  1149.              Tempo := MakeVar ();
  1150.           END;
  1151.        END;
  1152.     END;
  1153.     IF NOT IsFunction AND (Expr^.Kind # Tree.NoExpr) THEN
  1154.        Error ("illegal RETURN", Expr^.Expr.Pos);
  1155.     END;
  1156.     VarDecls := Decls;
  1157.    IF IsElement (ORD ('c'), Options) THEN
  1158.     HasTempos := (VarCount > 0) OR HasLocals;
  1159.    ELSE
  1160.     HasTempos := (VarCount > 0) OR HasLocals OR HasPatterns;
  1161.    END;
  1162.     CheckTargetCode (Patterns);
  1163.     CheckTargetCode (Exprs);
  1164.     IF IsFunction THEN
  1165.        CheckTargetCode (Expr);
  1166.     END;
  1167.     CheckTargetCode (Statements);
  1168.     Check (Next);
  1169. }; .
  1170. ProcCall (..) :- {
  1171.     CheckExprVar (Call, dFormals);
  1172.     Check (Call);
  1173.     Check (Next);
  1174. }; .
  1175. Condition (..) :- {
  1176.     CheckExprVar (Expr, dFormals);
  1177.     Check (Expr);
  1178.     Check (Next);
  1179. }; .
  1180. Assignment (..) :- {
  1181.     IF Adr^.Kind = Tree.VarUse THEN
  1182.        Object := IdentifyVar (Decls, Adr^.VarUse.Name);
  1183.     ELSE
  1184.        Object := NoTree;
  1185.     END;
  1186.     CheckExprVar (Adr, dFormals);
  1187.     IF Object # NoTree THEN
  1188.        CheckExprVar (Expr, Object);
  1189.     ELSE
  1190.        CheckExprVar (Expr, dFormals);
  1191.     END;
  1192.     Check (Adr);
  1193.     Check (Expr);
  1194.     Check (Next);
  1195. }; .
  1196. Fail (..) :- {
  1197.     IF IsFunction THEN
  1198.        Error ("FAIL not allowed in function", Pos);
  1199.     END;
  1200.     Check (Next);
  1201. }; .
  1202. TargetStmt (..) :- {
  1203.     CheckTargetCode (Parameters);
  1204.     MakeSet (UsedNames, MaxIdent ());
  1205.     ActNames := UsedNames;
  1206.     Check (Stmt);
  1207.     UsedNames := ActNames;
  1208.     Check (Next);
  1209. }; .
  1210. Statement (..) :- {
  1211.     Check (Next);
  1212. }; .
  1213. OnePattern (..) :- {
  1214.     Check (Pattern);
  1215.     Check (Next);
  1216. }; .
  1217. OneExpr (..) :- {
  1218.     Check (Expr);
  1219.     Check (Next);
  1220. }; .
  1221. Decompose (..) :- {
  1222.     Check (Expr);
  1223.     Success := TRUE;
  1224.     Check (Patterns);
  1225. }; .
  1226. VarDef (..) :- {
  1227.     IF Object # NoTree THEN Success := TRUE; END;
  1228. }; .
  1229. NilTest (..) :- {
  1230.     Success := TRUE;
  1231. }; .
  1232. Value (..) :- {
  1233.     Success := TRUE;
  1234.     Check (Expr);
  1235. }; .
  1236. Compose (..) :- {
  1237.     Check (Expr);
  1238.     Check (Exprs);
  1239. }; .
  1240. Call (..) :- {
  1241.     Check (Expr);
  1242.     Check (Exprs);
  1243.     Check (Patterns);
  1244. }; .
  1245. Binary (..) :- {
  1246.     Check (Lop);
  1247.     Check (Rop);
  1248. }; .
  1249. PreOperator (..) ;
  1250. PostOperator (..) ;
  1251. Parents (..) :- {
  1252.     Check (Expr);
  1253. }; .
  1254. Index (..) :- {
  1255.     Check (Expr);
  1256.     Check (Exprs);
  1257. }; .
  1258. TargetExpr (..) :- {
  1259.     MakeSet (UsedNames, MaxIdent ());
  1260.     ActNames := UsedNames;
  1261.     Check (Expr);
  1262.     UsedNames := ActNames;
  1263. }; .
  1264. Ident (..) :- {
  1265.     IF IdentifyVar (Decls, Attribute) = NoTree THEN Include (ActNames, Attribute); END;
  1266.     Check (Next);
  1267. }; .
  1268. Any (..) ;
  1269. Anys (..) :- {
  1270.     Check (Next);
  1271. }; .
  1272. Designator (..) :- {
  1273.     IF IsElement (Selector, LabelNames) THEN
  1274.        Object := IdentifyVar (Decls, Selector);
  1275.        IF Object^.Formal.TypeDesc^.Kind = Tree.NodeTypes THEN
  1276.           ActClass := LookupClass (Object^.Formal.TypeDesc^.NodeTypes.TreeName^.TreeName.Classes,
  1277.                   Minimum (Object^.Formal.TypeDesc^.NodeTypes.Types));
  1278.           Type := ActClass^.Class.Name;
  1279.        ELSE
  1280.           Error ("tree-type required", Pos);
  1281.        END;
  1282.     ELSE
  1283.        Error ("label not declared or computed", Pos);
  1284.     END;
  1285.     Check (Next);
  1286. }; .
  1287.  
  1288.  
  1289. PROCEDURE CheckTargetCode (t: Tree)
  1290.  
  1291. Param (..) :- {
  1292.     HasLocals := TRUE;
  1293.     ParamName := Name;
  1294.     IsOutput := FALSE;
  1295.     ProcFormals (Type);
  1296.     IF IsElement (Name, LabelNames) THEN
  1297.        Error ("label multiply declared or computed", Pos);
  1298.     ELSE
  1299.        Include (LabelNames, Name);
  1300.     END;
  1301.     CheckTargetCode (Next);
  1302. }; .
  1303. ProcCall (..) :- {
  1304.     CheckTargetCode (Call);
  1305.     CheckTargetCode (Next);
  1306. }; .
  1307. Condition (..) :- {
  1308.     CheckTargetCode (Expr);
  1309.     CheckTargetCode (Next);
  1310. }; .
  1311. Assignment (..) :- {
  1312.     CheckTargetCode (Expr);
  1313.     CheckTargetCode (Next);
  1314. }; .
  1315. TargetStmt (..) :- {
  1316.     ActNames := UsedNames;
  1317.     CheckTargetCode (Stmt);
  1318.     ReleaseSet (UsedNames);
  1319.     CheckTargetCode (Next);
  1320. }; .
  1321. Statement (..) :- {
  1322.     CheckTargetCode (Next);
  1323. }; .
  1324. OnePattern (..) :- {
  1325.     CheckTargetCode (Pattern);
  1326.     CheckTargetCode (Next);
  1327. }; .
  1328. OneExpr (..) :- {
  1329.     CheckTargetCode (Expr);
  1330.     CheckTargetCode (Next);
  1331. }; .
  1332. Decompose (..) :- {
  1333.     CheckTargetCode (Expr);
  1334.     CheckTargetCode (Patterns);
  1335. }; .
  1336. Value (..) :- {
  1337.     CheckTargetCode (Expr);
  1338. }; .
  1339. Compose (..) :- {
  1340.     CheckTargetCode (Expr);
  1341.     CheckTargetCode (Exprs);
  1342. }; .
  1343. Call (..) :- {
  1344.     CheckTargetCode (Expr);
  1345.     CheckTargetCode (Exprs);
  1346.     CheckTargetCode (Patterns);
  1347. }; .
  1348. Binary (..) :- {
  1349.     CheckTargetCode (Lop);
  1350.     CheckTargetCode (Rop);
  1351. }; .
  1352. PreOperator (..) ;
  1353. PostOperator (..) ;
  1354. Parents (..) :- {
  1355.     CheckTargetCode (Expr);
  1356. }; .
  1357. Index (..) :- {
  1358.     CheckTargetCode (Expr);
  1359.     CheckTargetCode (Exprs);
  1360. }; .
  1361. TargetExpr (..) :- {
  1362.     ActNames := UsedNames;
  1363.     CheckTargetCode (Expr);
  1364.     ReleaseSet (UsedNames);
  1365. }; .
  1366. Ident (..) :- {
  1367.     IF IsElement (Attribute, ActNames) AND (IdentifyVar (Decls, Attribute) # NoTree) THEN
  1368.        Error ("label not computed yet", Pos);
  1369.     END;
  1370.     CheckTargetCode (Next);
  1371. }; .
  1372. Any (..) ;
  1373. Anys (..) ;
  1374. Designator (..) :- CheckTargetCode (Next); .
  1375.  
  1376. PROCEDURE RemoveTreeTypes (t: Tree)
  1377.  
  1378. Spec (..) :-
  1379.    RemoveTreeTypes (TreeNames);
  1380.    .
  1381. TreeName (..) :-
  1382. String1: tString, String2: tString, i: tIdent;
  1383. {
  1384.    ArrayToString ("t", String1);
  1385.    GetString (Name, String2);
  1386.    Concatenate (String1, String2);
  1387.    i := MakeIdent (String1);
  1388.    IF i <= TypeCount THEN Exclude (TypeNames, i); END;
  1389.    RemoveTreeTypes (Next);
  1390. }; .
  1391.  
  1392. PREDICATE HasReject (Statements)
  1393.  
  1394. Reject (..) :- .
  1395. Statement (..) :- HasReject (Next); .
  1396.